R Notebook

#pacman::p_install_gh("systats/binoculaR")
pacman::p_load(tidyverse, haven, magrittr, binoculaR)

Load in Data

ss <- get(load(url("https://github.com/favstats/GodlyGovernance/raw/master/data/arab4.Rdata")))

Warning in .Internal(exists(x, envir, mode, inherits)) :
  closing unused connection 3 (https://github.com/favstats/GodlyGovernance/raw/master/data/arab4.sav)

Inspect Data

#b_select <- binoculaR::binoculaR(arab4)
#dput(b_select$var_codes)
index <- c("country","wt" ,"sample" ,"a1", "q1", "q2", "q13", "q5182", 
"q5184", "q6013", "q6014", "q6018", "q60118", "q605a", "q6061", "q6062", 
"q6063", "q6064", "q6071", "q6074", "q6076", "q707", "q708", 
"q7114", "q1001", "q1002", "q1003", "t1003", "q1004", "q1005", 
"q609", "q6101", "q6106", "q1012", "q1012a", "q1016")
arab4 %<>%
  select(index)
arab4

# save(arab4, file = "data/arab4.Rdata")

Filter Data

Recode Data

arab3 %<>% 
  mutate(cntry = sjmisc::to_label(country)) %>% 
  mutate(region = sjmisc::to_label(a1)) %>% 
  mutate(governorate = sjmisc::to_label(q1)) %>%
  mutate(district = sjmisc::to_label(q2)) 

Error in mutate_impl(.data, dots) : 
  Evaluation error: object 'q2' not found.

Factor Analysis

view_df2 <- function (x, weight.by = NULL, altr.row.col = TRUE, show.id = TRUE, 
  show.type = FALSE, show.values = TRUE, show.string.values = FALSE, 
  show.labels = TRUE, show.frq = FALSE, show.prc = FALSE, 
  show.wtd.frq = FALSE, show.wtd.prc = FALSE, show.na = FALSE, 
  max.len = 15, sort.by.name = FALSE, wrap.labels = 50, hide.progress = FALSE, 
  CSS = NULL, encoding = NULL, file = NULL, use.viewer = TRUE, 
  no.output = FALSE, remove.spaces = TRUE) 
{
  get.encoding <- function(encoding, data = NULL) {
  if (is.null(encoding)) {
    if (!is.null(data) && is.data.frame(data)) {
      # get variable label
      labs <- sjlabelled::get_label(data[[1]])
      # check if vectors of data frame have
      # any valid label. else, default to utf-8
      if (!is.null(labs) && is.character(labs))
        encoding <- Encoding(sjlabelled::get_label(data[[1]]))
      else
        encoding <- "UTF-8"
      # unknown encoding? default to utf-8
      if (encoding == "unknown") encoding <- "UTF-8"
    } else if (.Platform$OS.type == "unix")
      encoding <- "UTF-8"
    else
      encoding <- "Windows-1252"
  }
  return(encoding)
}
  has_value_labels <- function(x) {
  !(is.null(attr(x, "labels", exact = T)) && is.null(attr(x, "value.labels", exact = T)))
}
  sju.rmspc <- function(html.table) {
  cleaned <- gsub("      <", "<", html.table, fixed = TRUE, useBytes = TRUE)
  cleaned <- gsub("    <", "<", cleaned, fixed = TRUE, useBytes = TRUE)
  cleaned <- gsub("  <", "<", cleaned, fixed = TRUE, useBytes = TRUE)
  return(cleaned)
}
  
  encoding <- get.encoding(encoding, x)
  if (!is.data.frame(x)) 
    stop("Parameter needs to be a data frame!", call. = FALSE)
  df.var <- sjlabelled::get_label(x)
  df.val <- sjlabelled::get_labels(x)
  colcnt <- ncol(x)
  id <- seq_len(colcnt)
  if (sort.by.name) 
    id <- id[order(colnames(x))]
  tag.table <- "table"
  tag.thead <- "thead"
  tag.tdata <- "tdata"
  tag.arc <- "arc"
  tag.caption <- "caption"
  tag.omit <- "omit"
  css.table <- "border-collapse:collapse; border:none;"
  css.thead <- "border-bottom:double; font-style:italic; font-weight:normal; padding:0.2cm; text-align:left; vertical-align:top;"
  css.tdata <- "padding:0.2cm; text-align:left; vertical-align:top;"
  css.arc <- "background-color:#eeeeee"
  css.caption <- "font-weight: bold; text-align:left;"
  css.omit <- "color:#999999;"
  if (!is.null(CSS)) {
    if (!is.null(CSS[["css.table"]])) 
      css.table <- ifelse(substring(CSS[["css.table"]], 
        1, 1) == "+", paste0(css.table, substring(CSS[["css.table"]], 
        2)), CSS[["css.table"]])
    if (!is.null(CSS[["css.thead"]])) 
      css.thead <- ifelse(substring(CSS[["css.thead"]], 
        1, 1) == "+", paste0(css.thead, substring(CSS[["css.thead"]], 
        2)), CSS[["css.thead"]])
    if (!is.null(CSS[["css.tdata"]])) 
      css.tdata <- ifelse(substring(CSS[["css.tdata"]], 
        1, 1) == "+", paste0(css.tdata, substring(CSS[["css.tdata"]], 
        2)), CSS[["css.tdata"]])
    if (!is.null(CSS[["css.arc"]])) 
      css.arc <- ifelse(substring(CSS[["css.arc"]], 1, 
        1) == "+", paste0(css.arc, substring(CSS[["css.arc"]], 
        2)), CSS[["css.arc"]])
    if (!is.null(CSS[["css.caption"]])) 
      css.caption <- ifelse(substring(CSS[["css.caption"]], 
        1, 1) == "+", paste0(css.caption, substring(CSS[["css.caption"]], 
        2)), CSS[["css.caption"]])
    if (!is.null(CSS[["css.omit"]])) 
      css.omit <- ifelse(substring(CSS[["css.omit"]], 
        1, 1) == "+", paste0(css.omit, substring(CSS[["css.omit"]], 
        2)), CSS[["css.omit"]])
  }
  page.style <- sprintf("<style>\nhtml, body { background-color: white; }\n%s { %s }\n.%s { %s }\n.%s { %s }\n.%s { %s }\n%s { %s }\n.%s { %s }\n</style>", 
    tag.table, css.table, tag.thead, css.thead, tag.tdata, 
    css.tdata, tag.arc, css.arc, tag.caption, css.caption, 
    tag.omit, css.omit)
  toWrite <- sprintf("<html>\n<head>\n<meta http-equiv=\"Content-type\" content=\"text/html;charset=%s\">\n%s\n</head>\n<body>\n", 
    encoding, page.style)
  page.content <- sprintf("<table>\n  <caption>Data frame: %s</caption>\n", 
    deparse(substitute(x)))
  page.content <- paste0(page.content, "  <tr>\n    ")
  if (show.id) 
    page.content <- paste0(page.content, "<th class=\"thead\">ID</th>")
  page.content <- paste0(page.content, "<th class=\"thead\">Name</th>")
  if (show.type) 
    page.content <- paste0(page.content, "<th class=\"thead\">Type</th>")
  page.content <- paste0(page.content, "<th class=\"thead\">Label</th>")
  if (show.na) 
    page.content <- paste0(page.content, "<th class=\"thead\">missings</th>")
  if (show.values) 
    page.content <- paste0(page.content, "<th class=\"thead\">Values</th>")
  if (show.labels) 
    page.content <- paste0(page.content, "<th class=\"thead\">Value Labels</th>")
  if (show.frq) 
    page.content <- paste0(page.content, "<th class=\"thead\">Freq.</th>")
  if (show.prc) 
    page.content <- paste0(page.content, "<th class=\"thead\">%</th>")
  if (show.wtd.frq) 
    page.content <- paste0(page.content, "<th class=\"thead\">weighted Freq.</th>")
  if (show.wtd.prc) 
    page.content <- paste0(page.content, "<th class=\"thead\">weighted %</th>")
  page.content <- paste0(page.content, "\n  </tr>\n")
  if (!hide.progress) 
    pb <- utils::txtProgressBar(min = 0, max = colcnt, style = 3)
  for (ccnt in seq_len(colcnt)) {
    index <- id[ccnt]
    arcstring <- ""
    if (altr.row.col) 
      arcstring <- ifelse(sjmisc::is_even(ccnt), " arc", 
        "")
    page.content <- paste0(page.content, "  <tr>\n")
    if (show.id) 
      page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\">%i</td>\n", 
        arcstring, index))
    if (!is.list(x[[index]]) && !is.null(sjlabelled::get_note(x[[index]]))) 
      td.title.tag <- sprintf(" title=\"%s\"", sjlabelled::get_note(x[[index]]))
    else td.title.tag <- ""
    page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\"%s>%s</td>\n", 
      arcstring, td.title.tag, colnames(x)[index]))
    if (show.type) {
      vartype <- sjmisc::var_type(x[[index]])
      page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\">%s</td>\n", 
        arcstring, vartype))
    }
    if (index <= length(df.var)) {
      varlab <- df.var[index]
      if (!is.null(wrap.labels)) {
        varlab <- sjmisc::word_wrap(varlab, wrap.labels, 
          "<br>")
      }
    }
    else {
      varlab <- "<NA>"
    }
    page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\">%s</td>\n", 
      arcstring, varlab))
    if (show.na) {
      if (is.list(x[[index]])) {
        page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\"><span class=\"omit\">&lt;list&gt;</span></td>\n", 
          arcstring))
      }
      else {
        page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\">%i (%.2f%%)</td>\n", 
          arcstring, sum(is.na(x[[index]]), na.rm = T), 
          100 * sum(is.na(x[[index]]), na.rm = T)/nrow(x)))
      }
    }
    if (is.numeric(x[[index]]) && !has_value_labels(x[[index]])) {
      if (show.values || show.labels) {
        valstring <- paste0(sprintf("%a", range(x[[index]], 
          na.rm = T)), collapse = "-")
        if (show.values && show.labels) {
          colsp <- " colspan=\"2\""
          valstring <- paste0("<em>range: ", valstring, 
            "</em>")
        }
        else {
          colsp <- ""
        }
        page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\"%s>%s</td>\n", 
          arcstring, colsp, valstring))
      }
    }
    else {
      if (show.values) {
        valstring <- ""
        if (index <= ncol(x)) {
          if (is.list(x[[index]])) {
            valstring <- "<span class=\"omit\">&lt;list&gt;</span>"
          }
          else {
            vals <- sjlabelled::get_values(x[[index]])
            if (!is.null(vals)) {
              loop <- na.omit(seq_len(length(vals))[1:max.len])
              for (i in loop) {
                valstring <- paste0(valstring, vals[i])
                if (i < length(vals)) 
                  valstring <- paste0(valstring, "<br>")
              }
              if (max.len < length(vals)) 
                valstring <- paste0(valstring, "<span class=\"omit\">&lt;...&gt;</span>")
            }
          }
        }
        else {
          valstring <- "<NA>"
        }
        page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\">%s</td>\n", 
          arcstring, valstring))
      }
      if (show.labels) {
        valstring <- ""
        if (index <= length(df.val)) {
          if (is.list(x[[index]])) {
            valstring <- "<span class=\"omit\">&lt;list&gt;</span>"
          }
          else {
            vals <- df.val[[index]]
            if (!is.null(vals)) 
              vals <- na.omit(vals)
            if (is.character(x[[index]]) && !is.null(vals) && 
              !sjmisc::is_empty(vals)) {
              if (show.string.values) 
                vals <- sort(vals)
              else vals <- "<span class=\"omit\" title =\"'show.string.values = TRUE' to show values.\">&lt;output omitted&gt;</span>"
            }
            if (!is.null(vals)) {
              loop <- na.omit(seq_len(length(vals))[1:max.len])
              for (i in loop) {
                valstring <- paste0(valstring, vals[i])
                if (i < length(vals)) 
                  valstring <- paste0(valstring, "<br>")
              }
              if (max.len < length(vals)) 
                valstring <- paste0(valstring, "<span class=\"omit\">&lt;... truncated&gt;</span>")
            }
          }
        }
        else {
          valstring <- "<NA>"
        }
        page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\">%s</td>\n", 
          arcstring, valstring))
      }
    }
    if (show.frq) {
      if (is.list(x[[index]])) 
        valstring <- "<span class=\"omit\">&lt;list&gt;</span>"
      else valstring <- frq.value(index, x, df.val)
      page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\">%s</td>\n", 
        arcstring, valstring))
    }
    if (show.prc) {
      if (is.list(x[[index]])) 
        valstring <- "<span class=\"omit\">&lt;list&gt;</span>"
      else valstring <- prc.value(index, x, df.val)
      page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\">%s</td>\n", 
        arcstring, valstring))
    }
    if (show.wtd.frq && !is.null(weight.by)) {
      if (is.list(x[[index]])) 
        valstring <- "<span class=\"omit\">&lt;list&gt;</span>"
      else valstring <- frq.value(index, x, df.val, weight.by)
      page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\">%s</td>\n", 
        arcstring, valstring))
    }
    if (show.prc && !is.null(weight.by)) {
      if (is.list(x[[index]])) 
        valstring <- "<span class=\"omit\">&lt;list&gt;</span>"
      else valstring <- prc.value(index, x, df.val, weight.by)
      page.content <- paste0(page.content, sprintf("    <td class=\"tdata%s\">%s</td>\n", 
        arcstring, valstring))
    }
    if (!hide.progress) 
      utils::setTxtProgressBar(pb, ccnt)
    page.content <- paste0(page.content, "  </tr>\n")
  }
  if (!hide.progress) 
    close(pb)
  page.content <- paste(page.content, "</table>", sep = "\n")
  toWrite <- paste0(toWrite, sprintf("%s\n</body></html>", 
    page.content))
  knitr <- page.content
  knitr <- gsub("class=", "style=", knitr, fixed = TRUE, useBytes = TRUE)
  knitr <- gsub("<table", sprintf("<table style=\"%s\"", css.table), 
    knitr, fixed = TRUE, useBytes = TRUE)
  knitr <- gsub(tag.tdata, css.tdata, knitr, fixed = TRUE, 
    useBytes = TRUE)
  knitr <- gsub(tag.thead, css.thead, knitr, fixed = TRUE, 
    useBytes = TRUE)
  knitr <- gsub(tag.arc, css.arc, knitr, fixed = TRUE, useBytes = TRUE)
  if (remove.spaces) {
    knitr <- sju.rmspc(knitr)
    toWrite <- sju.rmspc(toWrite)
    page.content <- sju.rmspc(page.content)
  }
  structure(class = c("sjTable", "view_df"), list(page.style = page.style, 
    page.content = page.content, output.complete = toWrite, 
    header = NULL, knitr = knitr, file = file, show = !no.output, 
    use.viewer = use.viewer))
}